home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / forward-asm < prev    next >
Encoding:
Text File  |  1992-01-22  |  17.2 KB  |  660 lines
  1. \ Forward parsing assembler ... Mike Haas, Delta Research
  2. \
  3. \ This module adds a parser to convert normal 68000 source code
  4. \ (for the most part) into that compatible with the JForth reverse-polish
  5. \ assembler.
  6. \
  7. \ 09/27/87 mdh Fixed several problems...1) the parser would not recognize
  8. \              the '+64k' text as a register  2) negative signs were not
  9. \              being handled correctly  3) DBcc operands were not being
  10. \              passed on to the rev-polish assembler correctly.  Changed the
  11. \              parsed char for FORTH" <expression> " to FORTH{ expression }
  12. \              so that quoted strings could be handled.
  13. \ ?        mdh new EOL algorithm
  14. \ 06/20/88 mdh higher max-inline for speedup
  15. \ 1/25/89  plb set DPL in ASM to avoid 1,2,3 # problem
  16. \ 00001 27-sep-90 mdh/plb Add explicit LONG for .L, add ADD-SIZE
  17. \ 00002 15-aug-91 mdh/plb Use LWORD in Forth{ , not WORD
  18. \ 00003 18-aug-91 mdh     Incorporated XBLK
  19. \ 00004 25-sep-91 mdh     use ADD-SIZE? in PARSE-OPCODE instead of ADD-SIZE
  20.  
  21. max-inline @  256 max-inline !
  22. include? <res-code> jf:asm
  23. include? $interpret jf:string-interpret
  24.  
  25. only forth definitions
  26.  
  27. anew task-forward-asm
  28.  
  29. decimal
  30.  
  31. variable ShowASM?
  32.  
  33. assembler definitions
  34. forth
  35.   
  36. \ variables ...
  37.  
  38. variable DestExists
  39. variable +R+B
  40. variable DestAt
  41. variable DestLen
  42. variable TempMem
  43.  
  44. variable $BUFFER  80 allot
  45.  
  46. : SET.LINETEXT  ( -- )
  47.   CLINENUM @ >in @  eol lword count  ( >in@ text cnt )  80 min 2dup
  48.   LINETEXT 1+ swap move  LINETEXT c!   drop  >IN !  CLINENUM !
  49. ;
  50.  
  51.  
  52. : GETSCAN  ( -- cstart cline# lastscan )
  53.   clinestart @  clinenum @  lastscan @   both ;
  54.  
  55. : PUTSCAN  ( cstart cline# lastscan -- )
  56.   lastscan !  clinenum !  clinestart !   both ;
  57.  
  58. : CALLCFA   ( -- , input: <name> )
  59.   [compile] '  cfa,   \ dup cell- @ 0<
  60. \ IF   .err  ." This word cannot be CALLED (INLINE compile only!)"
  61. \      only forth definitions   quit
  62. \ THEN CALLADR,
  63. ;
  64.  
  65. : char>BUFFER  ( char -- )  showasm? @
  66.   IF  dup emit flushemit
  67.   THEN
  68.   $buffer count + c!
  69.   $buffer dup c@ 1+ swap c!  ;
  70.  
  71. : $>BUFFER  ( adr cnt -- )
  72.   showasm? @
  73.   IF  2dup type  flushemit
  74.   THEN
  75.   $buffer $append  ;
  76.  
  77. : >BUFFER  ( cnt-addr -- )  count $>buffer ;
  78.  
  79. : FILL-TIB?  ( -- , make sure TIB is not at end... )
  80. \  >in @  #tib @ >=     \ at end?
  81.   tib >in @ + #tib @ >in @ - bl skip nip 0=
  82.   IF    bl word  drop  \ yes, force a read from the file...
  83.         >in off        \ and point >in back to the beginning of it.
  84.   THEN  ;
  85.  
  86.  
  87. : IN-STRING?  ( $cntaddr-large $cnt-addr-small -- addr-matched OR 0 )
  88.   swap count
  89.   rot  count match?  both ;
  90.  
  91. : FORTH{  ( -- , executes whatever is in the { } )
  92.   also forth
  93.   eol lword  ( -- here ) " }"  in-string?  ?dup \ 00002
  94.   IF
  95.      here -  1- here c!   here  pad 100 +  $move
  96.      pad 100 + count $interpret
  97.   ELSE
  98.      " Improper 'FORTH{' directive: no trailing '}'"  $error
  99.   THEN
  100.   previous   ;
  101.  
  102.  
  103. : WHATS-NEXT  ( char -- here , do 'WORD' but restore >IN )
  104.   tib >in @ +
  105.   BEGIN  dup c@ dup
  106.          bl = swap  9 =  or
  107.   WHILE  1+
  108.   REPEAT tib - dup >in !  getscan 3 x>r
  109.   swap  word  swap >in !  3 xr> putscan  ;
  110.  
  111.  
  112. variable OpCnt
  113.  
  114. : get-operands  ( -- , get the operand string, put at here )
  115.   OpCnt off
  116.   0 eol whats-next count   ( -- IfIn[] $adr cnt )  0
  117.   DO
  118.      dup c@ >r     ( -- IfIn[] $adr )   ( -r- char )   over
  119.      IF
  120.         r@ ascii ] =
  121.         IF
  122.            nip 0 swap
  123.         THEN
  124.      ELSE
  125.         r@ ascii [ =
  126.         IF
  127.            nip true swap
  128.         ELSE
  129.            r@    bl =
  130.            r@     9 =  or
  131.            r@  $ 0a =  or  ( -- flag adr flag )
  132.            IF
  133.               rdrop leave
  134.            THEN
  135.         THEN
  136.      THEN
  137.      rdrop 1+   1 OpCnt +!
  138.   LOOP
  139.   drop
  140.   IF
  141.      >newline latest id. ." : unbalanced '[' and ']' combination" cr  0
  142.   ELSE
  143.      OpCnt @
  144.   THEN
  145.   here c!
  146. \
  147. \  eol whats-next   " ]" in-string?  -dup
  148. \  IF   BEGIN  1+ dup c@ >r
  149. \              r@    bl =
  150. \              r@     9 =  or
  151. \              r>  $ 0a =  or  ( -- adr flag )
  152. \              over  here -  here c@ 1+ = or
  153. \       UNTIL
  154. \  ELSE here c@ 1+ here c!  here "  " in-string?
  155. \  THEN 
  156. \  here 1+ -  here c!
  157. ;
  158.  
  159.  
  160. : GoPastThis  ( addr char -- addr2 , find the addr2 just past char )
  161.   swap
  162.   BEGIN   dup c@  ( -- char adr <adr> )   2 pick -
  163.   WHILE   1+
  164.   REPEAT  swap drop  ;
  165.  
  166. : #COMMAS?  ( -- flag , true if there is a comma in the text at here )
  167.   0  ( , counter )   here 1+ ( address )
  168.   BEGIN  dup c@  dup ascii , =
  169.          IF    drop   swap 1+  swap
  170.          ELSE  ascii [ =
  171.                IF    ascii ]  GoPastThis
  172.                THEN
  173.          THEN  ( #commas addr )
  174.          1+ dup  here dup c@ + >  ( #commas addr flag )
  175.   UNTIL  drop ;
  176.  
  177.  
  178. : CALC-DEST  ( -- )
  179.   here 1+
  180.   BEGIN   dup c@ dup ascii , -  ( -- addr char flag )
  181.   WHILE   dup ascii ( =         ( -- addr char flag )
  182.           IF   drop  ascii ) gopastthis  ( -- addr' )
  183.           ELSE ascii [ =
  184.                IF   ascii ] gopastthis
  185.                THEN
  186.           THEN 1+
  187.   REPEAT  drop dup destat ! ( addr of comma )
  188.   here -   here c@  swap -  destlen !  ( #chars AFTER comma )  ;
  189.  
  190. : GET-DEST  ( -- , moves the destination operands to 'HERE' )
  191.   here 32 bl fill
  192.   TempMem @  here  $move
  193. ;
  194.  
  195. \  destexists @ here c!
  196. \  1 destat +!  DestAt @  here 1+ -  dup 0<
  197. \  IF    " ASM: DestAt not SET"  $error
  198. \  THEN  here c@ - abs 1+ DestAT @  here 1+  2 pick move  dup here c!
  199. \  1+ here +  bl swap c!  ;
  200.  
  201.  
  202. : (ADR/CNT)  ( -- addr cnt , of the parens & the text between them )
  203.   here   " (" in-string?  dup
  204.   here   " )" in-string?  swap -  -dup
  205.   IF   1+
  206.   THEN ;
  207.  
  208.  
  209. : (,)?  ( -- flag , true if those chars are found in that order )
  210.   here  " ("  in-string? 
  211.   here  " ,"  in-string? 
  212.   here  " )"  in-string? ( -- a1 a2 a3 )
  213.   2 x>r  r@ <  2 xr>  < and  ;
  214.  
  215.  
  216. : END-CODE?  ( -- flag , true if the first text on the line is 'end-code' )
  217.   fblk @  blk @ or    xblk @ or ( 00003 )   0=
  218.   IF   cr query
  219.   THEN
  220.   SET.LINETEXT
  221.   getscan 3 x>r
  222.   >in @ bl word 1+      \ Save pointer, get the text      ( -- >in here )
  223.   " END-CODE" 1+          \ check the text      ( -- >in $END-CODE here+1 )
  224.   8 compare            ( -- >in flag )
  225.   IF   >in ! 3 xr> putscan  false
  226.   ELSE 3 xr> 2drop 2drop  true
  227.   THEN ;
  228.  
  229.  
  230. : LABEL?  ( -- flag , true if first col is a Moltorola-stype local label )
  231.           ( NOTE: the format is:   5$:  for example. )
  232.   bl whats-next    ( -- here )
  233.   " $:"  in-string? ;             \ Is there a '$:' there?   
  234.  
  235.  
  236. : PARSE-LABEL  ( -- , interpret the number, create a 'branchpoint' )
  237.   0.  bl word
  238.   convert  drop 2dup + 0=
  239.   IF   only forth definitions
  240.        " Invalid MC68000-ASM local label" $error
  241.   THEN drop showasm? @
  242.   IF
  243.      dup .  ." BR: "  flushemit
  244.   THEN  [ also assembler ]  br:  [ previous ]   ;
  245.  
  246.  
  247. : COMMENT?   ( -- flag , true if 1st char is '\', '(', or '*'
  248.    here  1+ c@
  249.    dup ascii ( = swap
  250.    dup ascii \ = swap
  251.    ascii * = or or
  252. ;
  253.  
  254. variable JustNum
  255.  
  256. : ABS?  ( charadr-after-num -- )  JustNum off
  257.   dup c@          ( -- charadr char )
  258.   CASE
  259.        ascii , OF    ascii L JustNum !   ENDOF
  260.             bl OF    ascii L JustNum !   ENDOF
  261.              9 OF    ascii L JustNum !   ENDOF
  262.        ascii . OF  dup 1+ c@ JustNum !   ENDOF
  263.   ENDCASE
  264.   drop
  265. ;
  266.  
  267.  
  268.  
  269. : GET[]?  ( addr -- true / false , moves forth cmd to $buffer, if there )
  270.   drop  here  " [" in-string? dup
  271.   IF   ( -- addr-of-[ ) 1+  here c@ here + over - 1+ ( -- addr maxlen )  0
  272.        DO   dup c@  ascii ] =  ?LEAVE
  273.             dup c@ ( -- addr char )  char>buffer  1+
  274.        LOOP bl char>buffer  ( -- adr-of-] )
  275.        here 1+ c@  dup ascii [ = swap ascii $ = or
  276.        IF   dup  1+ ABS?
  277.        THEN drop  true
  278.   THEN ;       
  279.  
  280.  
  281. : ADD-SIZE  ( char -- , add string to buffer  )
  282.     CASE
  283.         ascii B   OF   " BYTE " >buffer  ENDOF
  284.         ascii S   OF   " BYTE " >buffer  ENDOF
  285.         ascii W   OF   " WORD " >buffer  ENDOF
  286.         ascii L   OF   " LONG " >buffer  ENDOF ( 00001)
  287.     ENDCASE
  288. ;
  289.  
  290. : ADD-SIZE?  ( addr-of-period? -- )
  291.   dup c@  ascii . =
  292.   IF   dup 1+ c@ add-size
  293.   THEN  drop  ;
  294.  
  295. : STD-REG?  ( text-addr -- flag , true if Motorola-style reg  A2, d7, a3 etc)
  296.   dup c@ dup ascii D = swap ascii A = or   \ is Dx or Ax ?
  297.   ( -- addr flag1 )
  298.   swap 1+ c@  ascii 0 ascii 7 within?      and ;   \ is X0 thru X7 ?
  299.  
  300. variable lastreg  variable pastreg
  301. : PARSE-REG  ( addr-of-text flag -- , flag is whether to include DN or AN )
  302.   over  std-reg?
  303.         ( -- addr flag1 flag2 )  \ true if standard type reg notation
  304.   IF   swap ( -- flag1 addr ) dup 2+ >r  ( need later )
  305.        dup 1+ c@ dup >r ( save digit)   char>buffer  ( -- flag addr )
  306.        c@ dup >r dup char>buffer  " R " >buffer  swap
  307.        IF    char>buffer   " N " >buffer
  308.        ELSE  drop
  309.        THEN  ( -- )     ( --r-- # D-or-A )
  310.        $ 30  r> ascii A -
  311.        IF  $ 10 -
  312.        THEN  r> - abs lastreg !
  313.        r>   ( -- addr-of-next-char ) dup pastreg !
  314.   ELSE \ its a NAMED REGISTER!  ( -- adr flag )
  315.        \ first build the name as a string...
  316.        >r  0 swap ( -- counter addr ) ( -r- flag)
  317.        BEGIN  dup c@   ( -- cntr addr char )
  318.               dup  ascii , =
  319.               over bl     <= or
  320.               over ascii ) = or
  321.               over ascii ( = or
  322.               over ascii / = or
  323.               over 9       = or
  324.               over ascii . = or   0=
  325.               ( -- cntr addr char flag )
  326.        WHILE  char>buffer  ( -- cntr addr )  1+ swap 1+ swap
  327.        REPEAT drop dup pastreg !     ( -- cntr addr )
  328.        "  " >buffer  ( follow with a space )
  329.        ( -- cnt addr )  r> swap >r
  330.        ( --R-- addr )  ( -- cnt flag1 )  >r
  331.        \ string has been added to buffer
  332.        $BUFFER count +  ( -- count  next-char-adr )
  333.        over - 1- swap      ( -- $addr $cnt )
  334.        here pad $ 100 + $move
  335.        @reg  also assembler
  336.        $interpret   ( -- reg# )   previous
  337.        pad $ 100 + here $move  dup lastreg !  r>
  338.        IF   $ 10 and   IF  " DN " ELSE " AN "  THEN >buffer
  339.        ELSE drop
  340.        THEN  r>  ( -- Padr )
  341.   THEN ADD-SIZE?  ;
  342.  
  343. : PARSE-NUM  ( addr -- )
  344.   dup get[]?           ( -- addr flag )
  345.   IF   drop
  346.   ELSE dup c@ ascii $ =
  347.        IF   "  $ " >buffer    1+
  348.        THEN
  349.        BEGIN  dup c@   ( -- adr char )
  350.               dup  ascii 0  ascii 9 within?
  351.               over ascii A  ascii F within? or
  352.               over ascii -  = or
  353.               over ascii +  = or
  354.        WHILE  char>buffer 1+
  355.        REPEAT 2drop
  356.   THEN "  " >buffer
  357.   JustNum @ -dup
  358.   IF
  359.      " ABS." >Buffer
  360.      char>buffer  bl char>buffer
  361.   THEN  ;
  362.  
  363.  
  364. : PARSE-IMM  ( -- )
  365.   here 2+ parse-num
  366.   " #  " >buffer   ;
  367.  
  368.  
  369. : PARSE-PC   ( -- )
  370.   here  " PC,"  in-string? dup
  371.   IF   3 + false parse-reg  true
  372.   THEN
  373.   here 1+ parse-num
  374.   IF   " PC+R+B "
  375.   ELSE " PC+W "
  376.   THEN  >buffer
  377.   ;
  378.  
  379.  
  380. : PARSE-AN+R+B  ( -- )
  381.   here  " ("  in-string? 1+ 0 parse-reg
  382.   here  " ,"  in-string? 1+ 0 parse-reg
  383.   here 1+  parse-num
  384.   " AN+R+B " >buffer  
  385.   ;
  386.  
  387.  
  388. : PARSE-INDIRECT  ( -- )
  389.   here   " (" in-string? dup 1+ 0 PARSE-REG
  390.   1- c@ ascii - =
  391.   IF   " -A@ "
  392.   ELSE here   " )"  in-string? 1+ c@ ascii + =
  393.        IF   " A@+ "
  394.        ELSE here 1+ c@  ascii ( =
  395.             IF   " A@ "
  396.             ELSE here 1+ parse-num  " AN+W "
  397.             THEN
  398.        THEN
  399.   THEN >buffer
  400. ;
  401.  
  402. : NumberFirst?   ( -- flag )
  403.   base @ >r
  404.   here dup 1+ c@ ascii $ =
  405.   IF
  406.      1+  hex
  407.   THEN  ( -- charadr )  dup 1+ c@  ascii [ -
  408.   IF
  409.      0 0   ( -- adr d1 )  rot
  410.      convert  -rot 2drop    ( -- charadr )
  411.      dup ABS?  JustNum @
  412.      IF
  413.         drop true
  414.      ELSE
  415.         c@ ascii $ =      \ EXAMPLE:  23$
  416.      THEN
  417.   ELSE
  418.      drop here " ]" in-string? 1+ abs?  justnum @
  419.   THEN
  420.   r> base !
  421. ;
  422.   
  423. : PARSE-MODE  ( -- , builds text into $MODE-BUFFER )
  424.   \ formats to parse for:
  425.   \   reg ........... DN or AN
  426.   \   (An) .......... adr reg indirect
  427.   \   (An)+ ......... adr reg indirect w/ post-increment
  428.   \   -(An) ......... adr reg indirect w/ pre-decrement
  429.   \   d(An) ......... adr reg indirect w/ displacement
  430.   \   d(An,Xi) ...... adr reg indirect w/ index
  431.   \   d(PC) ......... PC relative
  432.   \   d(PC,Xi) ...... RC relative with index
  433.   \   # ............. immediate
  434.   \   [???] ......... Forth expression  
  435.   NumberFirst?
  436.   IF   here 1+ parse-num  \ does the local-labels, branches
  437.   ELSE
  438.        here 1+ c@  ascii # =         \ EXAMPLE:  #4
  439.        IF    PARSE-IMM
  440.        ELSE  here   " PC"  in-string?
  441.              IF    PARSE-PC
  442.              ELSE  +R+B @
  443.                    IF    PARSE-AN+R+B
  444.                    ELSE  here  " ("  in-string?
  445.                          IF    PARSE-INDIRECT
  446.                          ELSE  here 1+   true  PARSE-REG 
  447.                          THEN
  448.                    THEN
  449.              THEN
  450.        THEN
  451.   THEN    ;
  452.  
  453.  
  454. : SETDEST  ( -- )
  455.   DestExists @ 0=
  456.   IF
  457.      \
  458.      \ Find where dest ops are...
  459.      \
  460.      calc-dest
  461.      \
  462.      \ Save 'em in temp buffer...
  463.      \
  464.      TempMem @ dup >r  off
  465.      destat @ 1+  DestLen @  r> $append
  466.      \
  467.      \ Reflect source count...
  468.      \
  469.      here c@ destexists !             \ holds original len
  470.      destat @  here 1+ -  here c!     \ set for just source string
  471.   THEN  ;
  472.  
  473. : PARSE-HERE  ( -- )
  474.   +R+B OFF  #COMMAS?  -dup
  475.   IF   (,)?
  476.        IF    1 >  IF   setdest then
  477.              +R+B ON
  478.        ELSE  drop setdest
  479.        THEN
  480.   THEN PARSE-MODE
  481. ;
  482.  
  483.  
  484. : PARSE-SOURCE  ( -- )
  485.   destlen off
  486.   parse-here   ;
  487.  
  488. : PARSE-DEST  ( -- )
  489.   get-dest
  490.   parse-here ;
  491.  
  492.  
  493. : PARSE-OPCODE  ( -- , opcode is at pad )
  494.   pad   " ." in-string? dup>r
  495.   \
  496.                 \ 00004 dup
  497.                 \ 00004 IF   1+ c@
  498.                 \ 00004 THEN
  499.                 \ 00004 add-size
  500.   ?dup IF       \ 00004
  501.      add-size?  \ 00004
  502.   THEN          \ 00004
  503.   \
  504.   pad count   r>
  505.   IF  2-
  506.   THEN  $>buffer      ;
  507.  
  508.   
  509. : PARSE-NOT-MOVEM  ( -- )
  510.   [ also assembler ]
  511.   sourcem @ destinationm @
  512.   opcodem @ $ f000 [ previous ]  and $ 6000 =  or or
  513.   IF     get-operands
  514.          parse-source   destexists @ -dup
  515.          IF   here c!   parse-dest
  516.          THEN
  517.   THEN   parse-opcode
  518. ;
  519.  
  520. : SRC-REGLIST?  ( -- FLAG )
  521.   here " (" in-string?   setdest    DESTAT @  >=  ;
  522.  
  523. : ADDREG  ( reg# -- )   dup $ 30 or  char>buffer  $ 10 and
  524.   IF  " DR "   ELSE  " AR "  THEN  >BUFFER  ;
  525.  
  526. : PARSE-REG-LIST  ( adr -- )
  527.   1- dup >r    ( -- &cnt )    ( -r- &cnt )
  528.   dup c@ >r    ( -- &cnt )    ( -r- &cnt cnt )
  529.   -1 over c!   ( -- &cnt )    ( -r- &cnt cnt )
  530.   BEGIN  dup c@ 0   ( -- addr char flag )
  531.          over $ 0a    = or
  532.          over ascii , = or
  533.          over 9       = or
  534.          swap bl      = or 0=
  535.   WHILE  1+  ( -- addr )  \ not at end of reglist...
  536.          0 parse-reg  \ goes to buffer
  537.          pastreg @ dup c@ ascii - =   ( -- nextcharadr flag )
  538.          IF   ( continuous regs... )
  539.               lastreg @ 1+   swap 1+ 0 parse-reg  lastreg @ swap
  540.               DO   i addreg
  541.               LOOP  pastreg @
  542.          THEN
  543.   REPEAT drop r> r> c! ;
  544.  
  545. : PARSE-MOVEM   ( -- )
  546.   get-operands  src-reglist?
  547.   IF    here 1+ parse-reg-list
  548.         parse-dest
  549.   ELSE  parse-source
  550.         get-dest here 1+  parse-reg-list
  551.   THEN  parse-opcode ;        
  552.  
  553. : >ASM  ( -- )
  554.   also assembler  $buffer count $interpret  previous
  555. ;
  556.  
  557. : PARSE-ASM  ( -- , parse the 'OPCODE OPERANDS' syntax, disregard rest of line)
  558.   pad 20 erase          ( clear pad )
  559.   $buffer off  DestAt off
  560.   bl word dup pad $move    ( -- )   \ get the opcode & save it
  561.   CLINENUM @ ASMLINENUM !
  562.   " CALLCFA" $=
  563.   IF
  564.      [ also assembler ] callcfa  [ previous ]  true
  565.   ELSE
  566.      here  " BSR"  in-string?
  567.      IF
  568.         " ' " >buffer  bl word >buffer "  " >buffer  PARSE-OPCODE >ASM true
  569.      ELSE
  570.         here  " FORTH{"  $=
  571.         IF    [ also assembler ] forth{   [ previous ] true  
  572.         ELSE  false
  573.         THEN
  574.      THEN
  575.   THEN  0= dup >r
  576.   IF   
  577.        destexists off   here " ." in-string?
  578.        IF     here c@ 2- dup here c!  bl swap 1+ here + c!
  579.        THEN
  580.               here also assembler  find previous 0=
  581.        IF     only forth definitions   0 error  
  582.        then   do-does-size + [ also assembler ]  masks ! [ previous ]
  583.        pad  " MOVEM"  in-string? 
  584.        IF    PARSE-MOVEM 
  585.        ELSE  PARSE-NOT-MOVEM
  586.        THEN  showasm? @
  587.        IF    cr
  588.        THEN
  589.   THEN r>  ;
  590.  
  591. : ASM-LINE  ( -- )
  592.   bl whats-next c@
  593.   IF   \
  594.        label?   \ .................. Is the first column a label?
  595.        IF
  596.               parse-label  \ ......... Yes, process it.
  597.        THEN
  598.        comment?  \ ........... Do we disregard the entire line?
  599.        IF
  600.           eol word drop
  601.        ELSE
  602.           parse-asm   \ ..... No, assemble the line.
  603.           IF  >ASM
  604.          THEN
  605.        THEN
  606.        [compile] \    \ comment out any rest of the line...
  607.    THEN  ;
  608.  
  609. variable 'FASM-QUIT
  610.  
  611. : FASM.QUIT  ( -- , cause module to get hidden )
  612.   FASM.WHERE
  613.   'FASM-QUIT @ dup is quit  execute
  614. ;
  615.  
  616. : INSTALL.FASM ( --- )
  617.   what's quit 'FASM-QUIT !
  618.   also assembler  " FASM.QUIT" find drop is quit  previous
  619. ;
  620.  
  621. only forth definitions
  622.  
  623. : ASM   ( -- ) ( --- ) ( name --in-- )  
  624. \
  625.     -1 dpl !
  626.     BLK @
  627.     IF " ASM not available from screens; use CODE (RPN Assembler)" $ERROR
  628.     THEN
  629.     FBLK @ [ also assembler ] ASMFBLK [ previous ]  !
  630.     CLINEFILE @ [ also assembler ] ASMFNAME [ previous ]  !
  631.     base @ [ decimal ] 10 -
  632.     IF
  633.        >newline ." ASM: Forcing BASE to DECIMAL until END-CODE." cr
  634.     THEN
  635.     base @ >r  decimal
  636.     MEMF_CLEAR  64  allocblock?
  637.     dup [ also assembler ]  TempMem [ previous ]  !   markfreeblock
  638.     [ also assembler ]      INSTALL.FASM  [ previous ]
  639.     [compile] <res-code>  previous
  640.     BEGIN  [ also assembler ]
  641.            FILL-TIB?
  642.            end-code?  0=    \ .......... Is it the end?
  643.     WHILE  asm-line
  644.     REPEAT
  645.     [ previous ]
  646.     [compile] \
  647.     also assembler  [ also assembler ]
  648.     [compile] <res-end-code>
  649.     TempMem @ dup unmarkfreeblock  freeblock
  650.     'FASM-QUIT @ is quit
  651.     ASMFBLK off
  652.     [ previous ] r> base !
  653. ;
  654.  
  655.  
  656. \  immediate
  657.  
  658.  
  659. max-inline !
  660.